home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 1 / PC Actual CD 01.iso / f1 / hpn.arj / HANOI.BAS next >
Encoding:
BASIC Source File  |  1992-06-14  |  2.6 KB  |  72 lines
  1. DECLARE SUB presentacion ()
  2. DECLARE SUB juego ()
  3. DECLARE SUB rectangulo (x, I, c)
  4. DECLARE SUB elije (a1, a2)
  5. COMMON SHARED b() AS STRING, p() AS INTEGER, t() AS INTEGER, mov AS INTEGER
  6. DIM b(3) AS STRING, p(2) AS INTEGER, t(2) AS INTEGER
  7. CLS
  8. juego
  9. END
  10.  
  11.  
  12.  
  13. SUB elije (a1, a2)
  14. t(1) = a1: t(2) = a2: p(1) = 29: p(2) = 50
  15. DO
  16. FOR I = 1 TO 2
  17.   DO
  18.   LOCATE 23, p(I): PRINT CHR$(219)
  19.   a$ = INPUT$(1):
  20.   LOOP UNTIL INSTR("123", a$) > 0
  21. LOCATE 23, p(I): PRINT a$: t(I) = VAL(a$)
  22. NEXT I
  23. LOCATE 25, 5: PRINT "¿Correcto? (s/n/f) [s]": LOCATE 25, 29: PRINT CHR$(219): a$ = INPUT$(1): LOCATE 25, 25: PRINT "n": LOCATE 25, 27: PRINT " ": IF INSTR("fF", a$) > 0 THEN END
  24. LOOP WHILE (INSTR("nN", a$) > 0) OR (b(t(1)) = "") OR (RIGHT$(b(t(2)), 1) > RIGHT$(b(t(1)), 1))
  25. mov = mov + 1: LOCATE 23, 60: PRINT "Movimientos: "; mov
  26. LOCATE 25, 25: PRINT "s": LOCATE 25, 29: PRINT " "
  27. a1 = t(1)
  28. a2 = t(2)
  29. END SUB
  30.  
  31. SUB juego
  32. DO
  33. presentacion
  34. DO
  35. elije a1, a2
  36. c = VAL(RIGHT$(b(a1), 1))
  37. rectangulo a1, LEN(b(a1)), 1
  38. rectangulo a2, LEN(b(a2)) + 1, c + 1
  39. IF LEN(b(3)) = 5 THEN LOCATE 7, 5: PRINT "¡¡  L O    C O N S E G U I S T E  !!": LOCATE 9, 5: PRINT "Pulsa cualquier tecla...(Otra partida: 'S' )": EXIT DO
  40. LOOP
  41. x$ = INPUT$(1): CLS
  42. b(1) = "": b(2) = "": b(3) = "": mov = 0
  43. LOOP WHILE x$ = "s" OR x$ = "S"
  44. END SUB
  45.  
  46. SUB presentacion
  47. SCREEN 12
  48. DRAW "c9bm4,303m194,303bm225,303m415,303bm446,303m636,303"
  49. FOR I = 1 TO 3: LOCATE 21, I * 28 - 16: PRINT I: NEXT I
  50. FOR j = 1 TO 5: rectangulo 1, j, j + 1: NEXT j
  51. LOCATE 2, 24: PRINT " T O R R E S    D E    H A N O I"
  52. LOCATE 23, 1: PRINT "Coloca las piezas de la bandeja '1' en la bandeja '3'": PRINT " * moviendo unicamente las piezas superiores": PRINT " * sin que una pieza grande pueda colocarse encima de una pequeña": PRINT  _
  53. " * ayudándote de la bandeja vacía '2'"
  54. LOCATE 28, 17: PRINT "--- Pulsa cualquier tecla para continuar...---": a$ = INPUT$(1)
  55. LOCATE 23, 1: PRINT STRING$(480, "  ")
  56. LINE (0, 0)-(639, 459), , B
  57. LOCATE 23, 5: PRINT "Utiliza las teclas numericas. Pulsa cualquier tecla para continuar...": a$ = INPUT$(1)
  58. LOCATE 23, 5: PRINT STRING$(70, " ")
  59. DEF SEG = 0
  60. POKE &H417, PEEK(&H417) OR &H20
  61. LOCATE 23, 5: PRINT "* Mueve de la bandeja        a la bandeja          "
  62. DRAW "bm217,349s81rdlus1bm385,349s81rdlu"
  63. END SUB
  64.  
  65. SUB rectangulo (x, y, c)
  66. Q$ = MID$("012345", c, 1)
  67. IF c = 1 THEN b(x) = LEFT$(b(x), LEN(b(x)) - 1) ELSE b(x) = b(x) + Q$
  68. DRAW "c" + Q$ + "bm" + STR$((x - 1) * 219 + 100) + "," + STR$(300 - 27 * y) + "s10" + "l" + STR$(33 - 4 * c) + "u10r" + STR$(66 - 8 * c) + "d10l" + STR$(33 - 4 * c) + "bm-1,-1p" + Q$ + "," + Q$
  69.  
  70. END SUB
  71.  
  72.